Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / chasm.bas (.txt) < prev next >

Wrap

GW-BASIC | 1988-11-09 | 32.2 KB | 1,186 lines

10000 '=========================== 10010 'CHASM Version 2.13 10020 'Begun 6/15/82 by D. Whitman 10030 '=========================== 10040 DEFINT A-Z 10050 MAXOBJ = 74: DIM OBJ(74) 10060 MAXSTK = 10: DIM PROCTYPE(10): STKTOP = 0 10070 NUMOP = 227 10080 DIM OPCODE$(227),OPVAL(227),SRCTYPE(227),DSTTYPE(227),OFLAG(227) 10090 PREDEF = 29: MAXSYM = 200 10100 DIM SYM$(200),VAL1(200),VAL2(29),SYMTYPE(200) 10110 ' 10120 'main program 10130 GOSUB 50000 'init 10140 CHAIN MERGE "nul",10150,ALL,DELETE 50000-51770 'kill init code 10150 GOSUB 19710 'finish init 10160 GOSUB 10200 'pass 1: build sym table 10170 GOSUB 10440 'pass 2: obj code & listing 10180 GOSUB 19150 'clean up 10190 GOSUB 19510 'exit 10200 '=================== 10210 'PASSONE 10220 'Builds symbol table 10230 '=================== 10240 PASS = 1 10250 OPEN O$ AS #3 LEN=1: FIELD #3,1 AS BYTE$ 10260 LOCTR = 256 10270 LINENUM = 0 10280 BASCODE = FALSE 10290 WHILE NOT EOF(1) 10300 'abort? 10310 GOSUB 20010 10320 'get line, init 10330 GOSUB 10660 10340 'parse 10350 GOSUB 10830 10360 'label? add to table 10370 IF LABEL$ <> "" THEN GOSUB 11640 10380 'op? decode, update loctr 10390 IF OP$ <> "" THEN GOSUB 12420 10400 'report 10410 GOSUB 19580 10420 WEND 10430 RETURN 10440 '=================== 10450 'PASSTWO 10460 'Generates obj code & listing 10470 '=================== 10480 GOSUB 18870 'pass2_init 10490 WHILE NOT EOF(1) 10500 'abort? 10510 GOSUB 20010 10520 'get line, init 10530 GOSUB 10660 10540 'parse 10550 GOSUB 10830 10560 'phase? 10570 IF LABEL$ <> "" THEN GOSUB 11880 10580 'update loctr, gen. obj. code 10590 IF OP$ <> "" THEN GOSUB 12420 10600 'output 10610 GOSUB 18270 10620 'report 10630 GOSUB 19580 10640 WEND 10650 RETURN 10660 '=================== 10670 'GETLINE 10680 'Get line, expand tabs & set up 10690 '=================== 10700 LINE INPUT#1, INPLINE$ 10710 GOSUB 10770 'tabs 10720 LINENUM = LINENUM + 1 10730 NEEDOFFSET = NONE: DSFLAG = FALSE: ERRORFLAG = FALSE 10740 OBJLEN = 0 10750 RETURN 10760 'tabs 10770 I = INSTR(INPLINE$,CHR$(9)) 10780 WHILE I <> 0 10790 INPLINE$ = LEFT$(INPLINE$,I-1)+SPACE$(8-((I-1)MOD 8))+MID$(INPLINE$,I+1) 10800 I = INSTR(INPLINE$,CHR$(9)) 10810 WEND 10820 RETURN 10830 '================= 10840 'PARSE 10850 'Parses input line 10860 '================= 10870 LINEPTR = 1: LINEPTR2 = 1 10880 LABEL$ = "": OP$ = "": SOURCE$ = "": DEST$ = "" 10890 'mark end of code 10900 ENDPTR = INSTR(INPLINE$,";") - 1 10910 IF ENDPTR = -1 THEN ENDPTR = LEN(INPLINE$) 10920 'no code? (exit) 10930 IF ENDPTR = 0 THEN 11180 10940 'too long? 10950 IF ENDPTR <= 80 THEN 10980 10960 IF PASS = 2 THEN MSG$ = "Source line truncated": GOSUB 19030 10970 ENDPTR = 80 10980 'all caps 10990 GOSUB 11200 11000 'label? 11010 IF INSTR(DELIM$,LEFT$(INPLINE$,1)) THEN 11040 11020 GOSUB 11320 'getfield 11030 LABEL$ = FLD$ 11040 'opcode 11050 GOSUB 11320 'getfield 11060 IF NOT FOUND THEN 11180 11070 OP$ = FLD$ 11080 'save ptr to start of opds 11090 OPDPTR = LINEPTR 11100 'dest? 11110 GOSUB 11320 'getfield 11120 IF NOT FOUND THEN 11180 11130 DEST$ = FLD$ 11140 'src? 11150 GOSUB 11320 'getfield 11160 IF NOT FOUND THEN 11180 11170 SOURCE$ = FLD$ 11180 RETURN 11190 ' 11200 'subr caps 11210 'Caps inpline$ up to ";". Skips strings 11220 FOR I = 1 TO ENDPTR 11230 C$ = MID$(INPLINE$,I,1) 11240 'skip strings 11250 IF C$ <> "'" THEN 11290 11260 STRGEND = INSTR(I+1,INPLINE$,C$) 11270 IF STRGEND > 0 THEN I = STRGEND: GOTO 11300 11280 'convert 11290 IF ASC(C$) => 97 AND ASC(C$) <= 122 THEN C$ = CHR$(ASC(C$) - 32): MID$(INPLINE$,I,1) = C$ 11300 NEXT I 11310 RETURN 11320 '===================== 11330 'GETFIELD 11340 'Starting at lineptr, trys to get next field in FLD$ 11350 'Sets found if sucessful. Moves lineptr past field 11360 '===================== 11370 'find next non-delim or run off end 11380 WHILE LINEPTR <= ENDPTR 11390 IF INSTR(DELIM$,MID$(INPLINE$,LINEPTR,1)) = 0 THEN 11420 11400 LINEPTR = LINEPTR + 1 11410 WEND 11420 'past end? 11430 IF LINEPTR <= ENDPTR THEN 11460 11440 FOUND = FALSE 11450 RETURN 11460 'strings end with ' 11470 IF MID$(INPLINE$,LINEPTR,1) <> "'" THEN 11520 11480 STRGEND = INSTR(LINEPTR+1,INPLINE$,"'") 11490 IF STRGEND = 0 THEN 11520 11500 LINEPTR2 = STRGEND + 1 11510 GOTO 11580 11520 'else, find delim or go past end 11530 LINEPTR2 = LINEPTR 11540 WHILE LINEPTR2 <= ENDPTR 11550 IF INSTR(DELIM$,MID$(INPLINE$,LINEPTR2,1)) > 0 THEN 11580 11560 LINEPTR2 = LINEPTR2 + 1 11570 WEND 11580 'copy field 11590 FLD$ = MID$(INPLINE$,LINEPTR,LINEPTR2-LINEPTR) 11600 'lineptr past field, set found 11610 LINEPTR = LINEPTR2 11620 FOUND = TRUE 11630 RETURN 11640 '==================== 11650 'NEWENTRY 11660 'Adds symbol to table 11670 '==================== 11680 'bad? 11690 IF INSTR("1234567890-+",LEFT$(LABEL$,1)) = 0 THEN 11720 11700 MSG$ = "Illegal Label: " + LABEL$: GOSUB 19030 11710 LABEL$ = "": RETURN 11720 'already there? 11730 TARGET$ = LABEL$ 11740 GOSUB 11990 'operand_lookup 11750 IF NOT FOUND THEN 11780 11760 MSG$ = "Duplicate definition of "+LABEL$+" ": GOSUB 19030 11770 RETURN 11780 'table full? 11790 IF NUMSYM < MAXSYM THEN 11820 11800 MSG$ = "Too many user symbols": GOSUB 19030 11810 RETURN 11820 'else make new entry 11830 NUMSYM = NUMSYM + 1 11840 SYM$(NUMSYM) = LABEL$ 11850 VAL1(NUMSYM) = LOCTR 11860 SYMTYPE(NUMSYM) = NEAR 11870 RETURN 11880 '================= 11890 'CHECK_PHASE 11900 'Label value same both passes? 11910 '================= 11920 IF OP$ = "EQU" THEN 11980 11930 TARGET$ = LABEL$ 11940 GOSUB 11990 'operand_lookup 11950 IF (SYMTYPE(TABLEPTR) AND (NEAR OR MEM)) = FALSE THEN 11980 11960 IF VAL1(TABLEPTR) = LOCTR THEN 11980 11970 MSG$ = "Phase Error": GOSUB 19030 11980 RETURN 11990 '========================= 12000 'OPERAND_LOOKUP 12010 'Trys to find TARGET$ in sym table. If there 12020 'sets FOUND true, & TABLEPTR to its position 12030 '========================= 12040 'scan table 12050 FOR TABLEPTR = 1 TO NUMSYM 12060 IF SYM$(TABLEPTR) = TARGET$ THEN 12110 12070 NEXT TABLEPTR 12080 'failure 12090 FOUND = FALSE 12100 RETURN 12110 'sucess 12120 FOUND = TRUE 12130 RETURN 12140 '======================== 12150 'LOOKUP_OP 12160 'Given op-code in op$, & operand types in dtype & 12170 'stype, trys to find op in opcode table. If there 12180 'sets found true, & opptr to its position. 12190 '======================== 12200 'binary search for good starting pt. 12210 MOVE = NUMOP: ST = MOVE/2 12220 WHILE MOVE >= 2 12230 MOVE = MOVE/2 12240 IF OP$ > OPCODE$(ST) THEN ST = ST + MOVE ELSE ST = ST - MOVE 12250 IF ST < 1 THEN ST = 1 12260 IF ST > NUMOP THEN ST = NUMOP 12270 WEND 12280 'match all 3 fields 12290 FOR OPPTR = ST TO NUMOP 12300 IF OPCODE$(OPPTR) > OP$ THEN 12360 'failed 12310 IF OPCODE$(OPPTR) <> OP$ THEN 12350 12320 IF (SRCTYPE(OPPTR) AND STYPE) = FALSE THEN 12350 12330 IF (DSTTYPE(OPPTR) AND DTYPE) = FALSE THEN 12350 12340 GOTO 12390 'found! 12350 NEXT OPPTR 12360 'failure 12370 FOUND = FALSE 12380 RETURN 12390 'success 12400 FOUND = TRUE 12410 RETURN 12420 '=========================== 12430 'UPDATE_LOCTR 12440 'Decodes op & advances loctr 12450 '2nd pass, generate obj code 12460 '=========================== 12470 'set operand types & vals 12480 'dest 12490 TARGET$ = DEST$: GOSUB 12750 'type_operand 12500 DTYPE = TARGTYPE: DVAL1 = TARGVAL1: DVAL2 = TARGVAL2 12510 'src 12520 'special case: RET op 12530 IF OP$ = "RET" THEN STYPE = PROCTYPE(STKTOP): GOTO 12570 12540 'normal 12550 TARGET$ = SOURCE$: GOSUB 12750 'type_operand 12560 STYPE = TARGTYPE: SVAL1 = TARGVAL1: SVAL2 = TARGVAL2 12570 'find op in op table (not there: error) 12580 TARGET$ = OP$ 12590 GOSUB 12140 'lookup_op 12600 IF FOUND THEN 12700 12610 IF PASS = 1 THEN RETURN 12620 MSG$ = "Syntax Error: "+ OP$ + " " + STR$(DTYPE) + " " + STR$(STYPE) 12630 GOSUB 19030 12640 IF ((ACUM8 OR ACUM16 OR REG8 OR REG16 OR SEGR OR CS) AND (DTYPE OR STYPE)) THEN 12690 12650 IF (STYPE AND (NONE OR IMMED8 OR IMMED16)) = FALSE THEN 12690 12660 IF INSTR("BW",RIGHT$(OP$,1)) <> 0 THEN 12690 12670 DIAGFLAG = TRUE 12680 MSG$ = "Specify word or byte operation": GOSUB 19030 12690 RETURN 12700 FLAG = OFLAG(OPPTR) 12710 ' 12720 'branch to update loctr 12730 IF FLAG AND MACHOP THEN GOSUB 14890 ELSE GOSUB 15640 12740 RETURN 12750 '===================== 12760 'TYPE_OPERAND 12770 'Sets TARGTYPE to TARGET$'s type. Sets 12780 'TARGVAL1 to its value. If a reg, sets 12790 'TARVAL2 to its val2. If offset appears 12800 'NEEDOFFSET & OFFSET are set. 12810 '====================== 12820 'any operand? 12830 IF LEN(TARGET$) > 0 THEN 12860 12840 TARGTYPE = NONE 12850 RETURN 12860 'in sym table? 12870 GOSUB 11990 12880 IF NOT FOUND THEN 12920 12890 TARGTYPE = SYMTYPE(TABLEPTR): TARGVAL1 = VAL1(TABLEPTR) 12900 IF TABLEPTR <= PREDEF THEN TARGVAL2 = VAL2(TABLEPTR) 12910 RETURN 12920 'number? 12930 GOSUB 13320 12940 IF NOT FOUND THEN 12970 12950 TARGTYPE = NUMTYPE: TARGVAL1 = NUMVAL 12960 RETURN 12970 'mem ref? 12980 GOSUB 13690 12990 IF NOT FOUND THEN 13020 13000 TARGTYPE = MEM: TARGVAL1 = MEMADDR 13010 RETURN 13020 'offset off register? 13030 GOSUB 13990 13040 IF NOT FOUND THEN 13080 13050 TARGTYPE = MEMREG: TARGVAL1 = REGVAL 13060 RETURN 13070 'offset? 13080 GOSUB 14550 13090 IF NOT FOUND THEN 13120 13100 TARGTYPE = OFFSETYPE: TARGVAL1 = OFFSETVAL 13110 RETURN 13120 'char? 13130 GOSUB 14780 13140 IF NOT FOUND THEN 13170 13150 TARGTYPE = IMMED8 OR IMMED16: TARGVAL1 = CHARVAL 13160 RETURN 13170 'string? 13180 IF LEFT$(TARGET$,1) <> "'" THEN 13210 13190 TARGTYPE = STRING 13200 RETURN 13210 'not found? assume label or mem (pass 2 error) 13220 IF PASS = 1 THEN 13300 13230 MSG$ = "Undefined Symbol "+TARGET$: GOSUB 19030 13240 'look like hex? 13250 IF RIGHT$(TARGET$,1) <> "H" OR LEN(TARGET$) > 5 THEN 13300 13260 FOR I = 1 TO LEN(TARGET$)-1 13270 IF INSTR("1234567890ABCDEF", MID$(TARGET$,I,1)) = 0 THEN 13300 13280 NEXT I 13290 MSG$ = "Add leading zero to hex constant":DIAGFLAG = TRUE: GOSUB 19030 13300 TARGTYPE = NEAR OR MEM 13310 RETURN 13320 '===================== 13330 'TEST_NUMBER 13340 'Trys to interpret TARGET$ as a num 13350 'If sucessful, sets FOUND true, NUMVAL 13360 'to its value and NUMTYPE to its type 13370 '===================== 13380 FOUND = FALSE 13390 IF INSTR("1234567890-+",LEFT$(TARGET$,1)) = 0 THEN RETURN 13400 TN$ = TARGET$ 'make copy 13410 IF LEFT$(TN$,1) = "0" THEN TN$ = RIGHT$(TN$,LEN(TN$)-1) 13420 'hex? 13430 IF (RIGHT$(TN$,1) <> "H") OR (LEN(TN$) > 5) THEN 13560 13440 'lop off H 13450 TN$ = LEFT$(TN$,LEN(TN$)-1) 13460 'non-hex digits? 13470 I = 1 13480 FOR I = 1 TO LEN(TN$) 13490 C$ = MID$(TN$,I,1) 13500 IF INSTR("0123456789ABCDEF",C$) = 0 THEN RETURN 13510 NEXT I 13520 'get value 13530 NUMVAL = VAL("&H"+TN$) 13540 'set type, return 13550 GOTO 13650 13560 'dec? 13570 'non-dec digits? 13580 FOR I = 1 TO LEN(TN$) 13590 C$ = MID$(TN$,I,1) 13600 IF INSTR("0123456789-+",C$) = 0 THEN RETURN 13610 NEXT I 13620 'get value (overflow?) 13630 NVAL# = VAL(TN$) 13640 IF NVAL# < 32768 AND NVAL# > -32769 THEN NUMVAL = NVAL# ELSE RETURN 13650 'sucess exit 13660 FOUND = TRUE 13670 IF LEN(HEX$(NUMVAL)) < 3 THEN NUMTYPE = IMMED16 OR IMMED8 ELSE NUMTYPE = IMMED16 13680 RETURN 13690 '================================== 13700 'MEMREF 13710 'Trys to interpret target$ as a mem 13720 'ref. If so, sets FOUND true, & 13730 'MEMADDR to the address referenced. 13740 '================================== 13750 MR$ = TARGET$ 'save copy 13760 '[]? 13770 IF LEFT$(MR$,1) <> "[" OR RIGHT$(MR$,1) <> "]" THEN RETURN 13780 'strip [] 13790 TARGET$ = MID$(MR$,2,LEN(MR$)-2) 13800 'try to parse as addr 13810 'number? 13820 GOSUB 13320 13830 IF NOT FOUND THEN 13860 13840 MEMADDR = NUMVAL 13850 GOTO 13960 'exit 13860 'symbol? 13870 GOSUB 11990 13880 IF NOT FOUND THEN 13920 13890 IF (SYMTYPE(TABLEPTR) AND IMMED16) = FALSE THEN 13920 13900 MEMADDR = VAL1(TABLEPTR) 13910 GOTO 13960 'exit 13920 'failure 13930 FOUND = FALSE 13940 TARGET$ = MR$ 13950 RETURN 13960 'sucess 13970 TARGET$ = MR$ 13980 RETURN 13990 '======================================= 14000 'PARSE_DISP_OFF_REG 14010 'Trys to parse TARGET$ as offset off reg 14020 'If so, sets FOUND true, sets NEEDOFFSET 14030 'to offset's type, and OFFSET its value 14040 '======================================= 14050 PDOR$ = TARGET$ 'save copy 14060 ' 14070 'special case 14080 IF TARGET$ = "[BP]" THEN REGVAL = 6: NEEDOFFSET = IMMED8: OFFSET = 0: GOTO 14470 14090 ' 14100 'parse reg 14110 'set ptr to candidate 14120 PTR = INSTR(TARGET$,"[") 14130 IF PTR <= 1 THEN 14510 'no disp, exit 14140 'isolate candidate 14150 REG$ = RIGHT$(PDOR$,LEN(PDOR$)-PTR+1) 14160 'valid reg? 14170 IF REG$ = "[BP]" THEN REGVAL = 6: GOTO 14240 14180 TARGET$ = REG$ 14190 GOSUB 11990 'operand_lookup 14200 IF NOT FOUND OR SYMTYPE(TABLEPTR) <> MEMREG THEN 14510 14210 'save reg value 14220 REGVAL = VAL1(TABLEPTR) 14230 ' 14240 'now parse disp. 14250 'isolate candidate 14260 DISP$ = LEFT$(PDOR$,PTR-1) 14270 'valid disp? 14280 TARGET$ = DISP$ 14290 'might be symbol 14300 GOSUB 11990 14310 IF NOT FOUND THEN 14360 'not sym 14320 IF (SYMTYPE(TABLEPTR) AND (IMMED16 OR IMMED8)) = FALSE THEN 14360 14330 OFFSET = VAL1(TABLEPTR) 14340 NEEDOFFSET = SYMTYPE(TABLEPTR) 14350 GOTO 14470 14360 'or number 14370 GOSUB 13320 14380 IF NOT FOUND THEN 14420 14390 OFFSET = NUMVAL 14400 IF OFFSET > 127 OR OFFSET < -128 THEN NEEDOFFSET = IMMED16 ELSE NEEDOFFSET = IMMED8 14410 GOTO 14470 14420 'or offset 14430 GOSUB 14550 'offset 14440 IF NOT FOUND THEN 14510 14450 OFFSET = OFFSETVAL 14460 NEEDOFFSET = IMMED16 14470 'sucess 14480 TARGET$ = PDOR$ 14490 FOUND = TRUE 14500 RETURN 14510 'failure 14520 TARGET$ = PDOR$ 14530 FOUND = FALSE 14540 RETURN 14550 '========================== 14560 'OFFSET 14570 'Trys to interpret TARGET$ as an offset 14580 'If sucessful, set FOUND, set OFFSETYPE 14590 'to immed16, TARGVAL1 to label's offset 14600 '========================== 14610 OS$ = TARGET$ 14620 IF LEFT$(OS$,7) <> "OFFSET(" THEN FOUND = FALSE: RETURN 14630 IF PASS = 1 THEN 14740 14640 'isolate label 14650 TARGET$ = MID$(TARGET$,8,LEN(TARGET$)-8) 14660 'look it up 14670 GOSUB 11990 14680 IF FOUND AND (SYMTYPE(TABLEPTR) AND (MEM OR NEAR)) THEN 14720 14690 MSG$ = "Illegal or undefined argument for Offset": GOSUB 19030 14700 OFFSETVAL = 0 14710 GOTO 14740 14720 OFFSETVAL = VAL1(TABLEPTR) 14730 ' 14740 FOUND = TRUE 14750 OFFSETYPE = IMMED16 14760 TARGET$ = OS$ 14770 RETURN 14780 '================= 14790 'CHAR 14800 'Trys to parse TARGET$ as char 14810 '================= 14820 FOUND = FALSE 14830 IF LEN(TARGET$) <> 3 THEN RETURN 14840 IF LEFT$(TARGET$,1) <> "'" THEN RETURN 14850 IF RIGHT$(TARGET$,1) <> "'" THEN RETURN 14860 FOUND = TRUE 14870 CHARVAL = ASC(MID$(TARGET$,2,1)) 14880 RETURN 14890 '============================= 14900 'MACHOP 14910 'Updates loctr based on op len 14920 'On pass 2, generates obj. code 14930 '============================== 14940 GOSUB 15510 'op_type 14950 ' 14960 'opcode 14970 LOCTR = LOCTR + 1 14980 IF PASS = 2 THEN GOSUB 15700 'build_opcode 14990 ' 15000 '2nd op byte? 15010 IF (OPVAL(OPPTR) <> &HD5) AND (OPVAL(OPPTR) <> &HD4) THEN 15050 15020 LOCTR = LOCTR + 1 15030 IF PASS = 2 THEN OBJLEN = OBJLEN + 1: OBJ(OBJLEN) = &HA 15040 ' 15050 'room for m. byte disp. (must go here) 15060 IF NEEDOFFSET = NONE THEN 15090 15070 IF NEEDOFFSET AND IMMED8 THEN LOCTR = LOCTR+1: ELSE LOCTR = LOCTR+2 15080 ' 15090 'direct addr. mode byte? leave room for addr 15100 IF (FLAG AND (NEEDMODEBYTE OR NEEDEXT)) = FALSE THEN 15130 15110 IF (DTYPE OR STYPE) AND MEM THEN LOCTR = LOCTR + 2 15120 ' 15130 'ext. byte? 15140 IF (FLAG AND NEEDEXT) = FALSE THEN 15180 15150 LOCTR = LOCTR + 1 15160 IF PASS = 2 THEN GOSUB 15910 'build_ext 15170 ' 15180 'mode byte? 15190 IF (FLAG AND NEEDMODEBYTE) = FALSE THEN 15230 15200 LOCTR = LOCTR + 1 15210 IF PASS = 2 THEN GOSUB 16030 'build_modebyte 15220 ' 15230 '8 bit disp? 15240 IF (FLAG AND NEEDISP8) = FALSE THEN 15280 15250 LOCTR = LOCTR + 1 15260 IF PASS = 2 THEN GOSUB 16480 'build_disp8 15270 ' 15280 '16 bit disp? 15290 IF (FLAG AND NEEDISP16) = FALSE THEN 15330 15300 LOCTR = LOCTR + 2 15310 IF PASS = 2 THEN GOSUB 16650 'build_disp16 15320 ' 15330 'immed byte? 15340 IF (FLAG AND NEEDIMMED8) = FALSE THEN 15370 15350 LOCTR = LOCTR + 1 15360 IF PASS = 2 THEN GOSUB 16910 15370 IF WORD OR ((FLAG AND NEEDIMMED) = FALSE) THEN 15410 15380 LOCTR = LOCTR + 1 15390 IF PASS = 2 THEN GOSUB 16910 'build_immed8 15400 ' 15410 'immed word(s)? 15420 IF NOT(WORD) OR ((FLAG AND NEEDIMMED) = FALSE) THEN 15460 15430 IF DTYPE AND IMMED16 THEN LOCTR = LOCTR + 4 ELSE LOCTR = LOCTR + 2 15440 IF PASS = 2 THEN GOSUB 16780 'build_immed16 15450 ' 15460 'mem addr? 15470 IF (FLAG AND NEEDMEM) = FALSE THEN 15500 15480 LOCTR = LOCTR + 2 15490 IF PASS = 2 THEN GOSUB 17020 'mem_addr 15500 RETURN 15510 '================== 15520 'OP_TYPE 15530 'Decides between word & byte ops 15540 '================== 15550 IF (DTYPE OR STYPE) AND (REG16 OR ACUM16 OR SEGR OR CS) THEN 15580 15560 IF (DTYPE OR STYPE) AND (REG8 OR ACUM8) THEN 15610 15570 IF RIGHT$(OP$,1) = "B" THEN 15610 15580 'word 15590 WORD = TRUE 15600 RETURN 15610 'byte 15620 WORD = FALSE 15630 RETURN 15640 '========= 15650 'PSEUDO-OP 15660 '========= 15670 ON OPVAL(OPPTR) GOSUB 17140,17270,17320,17810,17970,18070,18150,18190 15680 ' EQU ORG DB DS PROC ENDP BSAVE EJECT 15690 RETURN 15700 '================== 15710 'BUILD_OPCODE 15720 'Builds opcode in OBJ 15730 '================== 15740 OBJLEN = OBJLEN + 1 15750 OBJ(OBJLEN) = OPVAL(OPPTR) 15760 ' 15770 'reg field? 15780 IF (FLAG AND ADDREG) = FALSE THEN 15840 15790 'seg reg 15800 IF DTYPE AND (SEGR OR CS) THEN R = DVAL2: GOTO 15830 15810 'normal reg 15820 IF (FLAG AND DIRECTION) THEN R = SVAL2/8 ELSE R = DVAL2/8 15830 OBJ(OBJLEN) = OBJ(OBJLEN) + R 15840 'word bit? 15850 IF (FLAG AND AUTOW) = FALSE THEN 15870 15860 IF WORD THEN OBJ(OBJLEN) = OBJ(OBJLEN) + 1 15870 'count bit? 15880 IF (FLAG AND AUTOC) = FALSE THEN 15900 15890 IF STYPE AND CL THEN OBJ(OBJLEN) = OBJ(OBJLEN) + 2 15900 RETURN 15910 '=================================== 15920 'BUILD_EXTENSION_BYTE 15930 'Builds opcode ext byte. Ext val is 15940 'extracted from bits 3-5 of flag word 15950 '==================================== 15960 'get ext 15970 MASK = &H38 15980 EXT = FLAG AND MASK 15990 'define proper opd as ext & build 16000 IF FLAG AND DIRECTION THEN DVAL2 = EXT ELSE SVAL2 = EXT 16010 GOSUB 16030 'build_modebyte 16020 RETURN 16030 '========================= 16040 'BUILD_MODE_BYTE 16050 'Given direction flag, memreg values in dval1 & sval1 & 16060 'reg values in dval2 & sval2, builds an addressing mode 16070 'byte. If necessary, also builds displacement byte(s). 16080 '========================= 16090 OBJLEN = OBJLEN + 1 16100 'special case: direct mem. addressing? 16110 IF ((DTYPE OR STYPE) AND MEM) = FALSE THEN 16170 16120 IF DTYPE = MEM THEN M = SVAL2 ELSE M = DVAL2 16130 OBJ(OBJLEN) = 6 + M 16140 GOSUB 17020 'build_mem_addr 16150 RETURN 16160 'normal mode byte 16170 'opds in normal or reverse order? 16180 IF FLAG AND DIRECTION THEN M = SVAL1 + DVAL2 ELSE M = DVAL1 + SVAL2 16190 OBJ(OBJLEN) = M 16200 'offset byte(s)? 16210 IF NEEDOFFSET = NONE THEN 16370 16220 '8 bit disp. 16230 IF OFFSET > 127 OR OFFSET < -128 THEN 16300 16240 OBJ(OBJLEN) = OBJ(OBJLEN) + 64 'set mod field 16250 'crunch neg. offset to 8 bits 16260 IF OFFSET < 0 THEN OFFSET = OFFSET AND &HFF 16270 OBJLEN = OBJLEN + 1 16280 OBJ(OBJLEN) = OFFSET 16290 RETURN 16300 '16 bit disp. 16310 OBJ(OBJLEN) = OBJ(OBJLEN) + 128 'set mod field 16320 OBJLEN = OBJLEN + 2 16330 'convert to hi/low form 16340 NUMLOW = OFFSET: GOSUB 16380 'hi/low 16350 OBJ(OBJLEN-1) = NUMLOW 16360 OBJ(OBJLEN) = NUMHIGH 16370 RETURN 16380 '===================================== 16390 'HI/LOW 16400 'Splits 16 bit number in numlow into 2 16410 'byte-sized chunks in numhigh & numlow 16420 '===================================== 16430 H$ = HEX$(NUMLOW) 16440 H$ = STRING$(4-LEN(H$),"0") + H$ 16450 NUMLOW = VAL("&H" + RIGHT$(H$,2)) 16460 NUMHIGH = VAL("&H" + LEFT$(H$,2)) 16470 RETURN 16480 '========================= 16490 'BUILD_DISP8 16500 'Builds displacement byte. Prints 16510 'error msg if disp. exceeds 127 16520 '========================= 16530 'calc disp. 16540 D = DVAL1 - LOCTR 16550 'check size 16560 IF ABS(D) < 128 THEN 16590 16570 D = 0 16580 IF PASS = 2 THEN MSG$ = "Too far for short jump": GOSUB 19030 16590 'if neg. crunch to 8 bits 16600 IF D < 0 THEN D = D AND &HFF 16610 'build obj. code 16620 OBJLEN = OBJLEN + 1 16630 OBJ(OBJLEN) = D 16640 RETURN 16650 '======================== 16660 'BUILD_DISP16 16670 'Builds displacement word 16680 '======================== 16690 'calc disp. 16700 D = DVAL1 - LOCTR 16710 IF OP$ = "JMP" AND (D < 128 AND D > -129) THEN DIAGFLAG = TRUE: MSG$ = "Could use JMPS": GOSUB 19030 16720 'build obj. code 16730 NUMLOW = D: GOSUB 16380 'hi/low 16740 OBJLEN = OBJLEN + 2 16750 OBJ(OBJLEN-1) = NUMLOW 16760 OBJ(OBJLEN) = NUMHIGH 16770 RETURN 16780 '============================ 16790 'BUILD_IMMED16 16800 'Builds word(s) of immed data 16810 '============================ 16820 IF DTYPE AND IMMED16 THEN IVAL = DVAL1: GOSUB 16850 16830 IF STYPE AND IMMED16 THEN IVAL = SVAL1: GOSUB 16850 16840 RETURN 16850 'subroutine immed16 16860 NUMLOW = IVAL: GOSUB 16380 'hi/low 16870 OBJLEN = OBJLEN + 2 16880 OBJ(OBJLEN-1) = NUMLOW 16890 OBJ(OBJLEN) = NUMHIGH 16900 RETURN 16910 '========================= 16920 'BUILD_IMMED8 16930 'Builds byte of immed data 16940 '========================= 16950 IF DTYPE AND IMMED8 THEN IVAL = DVAL1: GOSUB 16980 16960 IF STYPE AND IMMED8 THEN IVAL = SVAL1: GOSUB 16980 16970 RETURN 16980 'sub. immed8 16990 OBJLEN = OBJLEN + 1 17000 OBJ(OBJLEN) = IVAL 17010 RETURN 17020 '====================== 17030 'MEMREF 17040 'Builds a mem addr word 17050 '====================== 17060 'get addr in hi/low form 17070 IF DTYPE AND MEM THEN NUMLOW = DVAL1 ELSE NUMLOW = SVAL1 17080 GOSUB 16380 17090 'build word 17100 OBJLEN = OBJLEN + 2 17110 OBJ(OBJLEN-1) = NUMLOW 17120 OBJ(OBJLEN) = NUMHIGH 17130 RETURN 17140 '===== 17150 'EQU 17160 '===== 17170 IF (LABEL$ <> "") THEN 17200 17180 IF PASS = 2 THEN MSG$ = "EQU without symbol": GOSUB 19030 17190 RETURN 17200 IF PASS = 2 THEN 17260 17210 IF DTYPE <> (NEAR OR MEM) THEN 17240 'pass 1 default 17220 MSG$ = "EQU with forward reference": GOSUB 19030 17230 RETURN 17240 VAL1(NUMSYM) = DVAL1 17250 SYMTYPE(NUMSYM) = DTYPE 17260 RETURN 17270 '===== 17280 'ORG 17290 '===== 17300 LOCTR = DVAL1 17310 RETURN 17320 '===== 17330 'DB 17340 '===== 17350 IF PASS = 2 THEN 17380 17360 'label? type = mem 17370 IF LABEL$ <> "" THEN SYMTYPE(NUMSYM) = MEM 17380 'scan, building obj. code 17390 LINEPTR = OPDPTR: LINEPTR2 = OPDPTR 17400 WHILE LINEPTR < ENDPTR 17410 'get operand 17420 GOSUB 11320 'get_field 17430 IF NOT FOUND THEN 17630 'exit 17440 'branch for byte or string 17450 TARGET$ = FLD$: GOSUB 13320 'test_number 17460 IF NOT FOUND THEN 17490 17470 GOSUB 17650 'build_byte 17480 GOTO 17620 17490 GOSUB 11990 'operand lookup 17500 IF (NOT FOUND) OR ((SYMTYPE(TABLEPTR) AND (IMMED8 OR IMMED16)) = FALSE) THEN 17530 17510 NUMVAL = VAL1(TABLEPTR): NUMTYPE = SYMTYPE(TABLEPTR): GOSUB 17650 17520 GOTO 17620 17530 GOSUB 14550 'offset 17540 IF NOT FOUND THEN 17570 17550 NUMVAL = OFFSETVAL: NUMTYPE = IMMED16: GOSUB 17650 17560 GOTO 17620 17570 IF LEFT$(FLD$,1) <> "'" THEN 17600 17580 GOSUB 17740 'build_stg 17590 GOTO 17620 17600 'not byte or string? pass 2 error 17610 IF PASS = 2 THEN MSG$ = "Unrecognized operand "+FLD$: GOSUB 19030 17620 WEND 17630 LOCTR = LOCTR + OBJLEN 17640 RETURN 17650 'build_byte 17660 IF (NUMTYPE AND IMMED8) = FALSE THEN 17700 17670 OBJLEN = OBJLEN + 1 17680 OBJ(OBJLEN) = NUMVAL 17690 RETURN 17700 NUMLOW = NUMVAL: GOSUB 16430 'hi/low 17710 OBJLEN = OBJLEN + 1: OBJ(OBJLEN) = NUMLOW 17720 OBJLEN = OBJLEN + 1: OBJ(OBJLEN) = NUMHIGH 17730 RETURN 17740 'build_stg 17750 FLD$ = MID$(FLD$,2,LEN(FLD$)-2) 'strip off 's 17760 FOR I = 1 TO LEN(FLD$) 17770 OBJLEN = OBJLEN + 1 17780 OBJ(OBJLEN) = ASC(MID$(FLD$,I,1)) 17790 NEXT I 17800 RETURN 17810 '===== 17820 'DS 17830 '===== 17840 DSFLAG = TRUE 'signal a ds 17850 IF PASS = 2 THEN 17880 'skip type setting? 17860 'label? 17870 IF LABEL$ <> "" THEN SYMTYPE(NUMSYM) = MEM 17880 'output code 17890 IF STYPE AND IMMED8 THEN DSVAL = SVAL1 ELSE DSVAL = 0 17900 'pass 2, generate obj. code directly 17910 IF PASS = 1 THEN 17950 17920 FOR I = 1 TO DVAL1 17930 LSET BYTE$ = CHR$(DSVAL): PUT #3 17940 NEXT I 17950 LOCTR = LOCTR + DVAL1: BYTESGEN = BYTESGEN + DVAL1 17960 RETURN 17970 '====== 17980 'PROC 17990 '====== 18000 IF STKTOP < MAXSTK THEN 18030 18010 IF PASS = 2 THEN MSG$ = "Procedures nested too deeply": GOSUB 19030 18020 RETURN 18030 'push new proc type 18040 STKTOP = STKTOP + 1 18050 PROCTYPE(STKTOP) = DTYPE 18060 RETURN 18070 '====== 18080 'ENDP 18090 '====== 18100 IF STKTOP > 0 THEN 18130 18110 IF PASS = 2 THEN MSG$ = "ENDP without PROC": GOSUB 19030 18120 RETURN 18130 STKTOP = STKTOP - 1 18140 RETURN 18150 '===== 18160 'BSAVE 18170 '===== 18180 BASCODE = TRUE: RETURN 18190 '===== 18200 'EJECT 18210 '===== 18220 IF PASS = 1 THEN RETURN 18230 LINESUSED = LINENUM + DIAG + ERRS + XTRA 18240 PAGEPOS = LINESUSED MOD PAGELEN 18250 GOSUB 18750 18260 RETURN 18270 '=============== 18280 'OUTPUT 18290 'Outputs obj code & listing 18300 '=============== 18310 'src to scrn for errors 18320 IF ERRORFLAG AND (L$ <> "scrn:") THEN PRINT INPLINE$ 18330 'update # of bytes 18340 BYTESGEN = BYTESGEN + OBJLEN 18350 IF DSFLAG THEN H$ = HEX$(LOCTR-DVAL1) ELSE H$ = HEX$(LOCTR-OBJLEN) 18360 H$ = STRING$(4-LEN(H$),"0") + H$ 18370 PRINT#2, TAB(1) H$; 18380 'first 6 bytes 18390 I = 1 18400 PRINT#2, TAB(6) 18410 WHILE I <= 6 18420 IF I > OBJLEN THEN 18490 18430 LSET BYTE$ = CHR$(OBJ(I)): PUT #3 18440 H$ = HEX$(OBJ(I)): IF LEN(H$) = 1 THEN H$ = "0" + H$ 18450 PRINT#2, H$; 18460 I = I + 1 18470 WEND 18480 ' 18490 'source (truncate?) 18500 PRINT#2, TAB(19) 18510 PRINT#2, USING "####"; LINENUM; 18520 PRINT#2, SPACE$(2) LEFT$(INPLINE$, LWIDTH-26) 18530 ' 18540 'formfeed? 18550 GOSUB 18670 18560 ' 18570 'rest of obj. code 18580 WHILE I <= OBJLEN 18590 IF I MOD 6 = 1 THEN PRINT#2, TAB(6): XTRA = XTRA + 1: GOSUB 18670 18600 LSET BYTE$ = CHR$(OBJ(I)): PUT #3 18610 H$ = HEX$(OBJ(I)): IF LEN(H$) = 1 THEN H$ = "0" + H$ 18620 PRINT#2, H$; 18630 I = I + 1 18640 WEND 18650 IF OBJLEN > 6 THEN PRINT#2,: GOSUB 18670 18660 RETURN 18670 '========== 18680 'NEEDEJECT? 18690 '========== 18700 IF L$ <> "lpt1:" THEN RETURN 18710 LINESUSED = LINENUM + DIAG + ERRS + XTRA 18720 PAGEPOS = LINESUSED MOD PAGELEN 18730 IF PAGEPOS > MAXLINES THEN GOSUB 18750 18740 RETURN 18750 '=========================== 18760 'FORMFEED 18770 'Advances to next page given 18780 'current position in PAGEPOS 18790 '=========================== 18800 IF L$ <> "lpt1:" THEN RETURN 18810 FOR J = 1 TO (PAGELEN - PAGEPOS) 18820 PRINT#2, 18830 NEXT J 18840 XTRA = XTRA + PAGELEN - PAGEPOS 18850 PAGE = PAGE + 1: GOSUB 19840 'header 18860 RETURN 18870 '========== 18880 'PASS2_INIT 18890 '========== 18900 CLOSE 1: OPEN SC$ FOR INPUT AS 1 18910 IF NOT BASCODE THEN 19000 18920 'build bsave header 18930 LSET BYTE$ = CHR$(253): PUT 3 18940 FOR I = 1 TO 4 18950 LSET BYTE$ = CHR$(0): PUT 3 18960 NEXT I 18970 NUMLOW = LOCTR: GOSUB 16380 'hi/low 18980 LSET BYTE$ = CHR$(NUMLOW): PUT 3 18990 LSET BYTE$ = CHR$(NUMHIGH): PUT 3 19000 PASS = 2: LOCTR = 256: BYTESGEN = 0 19010 TOTALINES = LINENUM: LINENUM = 0 19020 RETURN 19030 '===================== 19040 'ERRMSG 19050 'Prints error & diag msgs 19060 '===================== 19070 ERRORFLAG = TRUE 19080 IF AUDIO THEN BEEP 19090 IF DIAGFLAG = TRUE THEN DIAG = DIAG + 1: PRINT#2, "****Diagnostic: "; ELSE ERRS = ERRS + 1: PRINT#2, "****"; 19100 PRINT #2, MSG$;: IF PASS = 1 THEN PRINT#2, " in"; LINENUM ELSE PRINT#2, 19110 IF L$ = "scrn:" THEN 19140 19120 IF DIAGFLAG THEN PRINT "****Diagnostic: "; ELSE PRINT "****"; 19130 PRINT MSG$; " in"; LINENUM 19140 DIAGFLAG = FALSE: RETURN 19150 '========= 19160 'FINALPROC 19170 '========= 19180 IF STKTOP > 0 THEN MSG$ = "Error: missing ENDP": GOSUB 19030 19190 PRINT#2,: PRINT#2,: PRINT#2, ERRS; "Error(s) detected" 19200 XTRA = XTRA + 3: GOSUB 18670 'page eject? 19210 PRINT#2, DIAG; "Diagnostic(s) offered": XTRA = XTRA + 1: GOSUB 18670 19220 PRINT#2,: PRINT#2, BYTESGEN;"(";HEX$(BYTESGEN); "H) Bytes of object code generated" 19230 XTRA = XTRA + 2: GOSUB 18670 19240 'scrn report 19250 IF L$ = "scrn:" THEN 19290 19260 PRINT: PRINT ERRS; "Error(s) detected" 19270 PRINT DIAG; "Diagnostic(s) offered" 19280 PRINT: PRINT BYTESGEN;"(";HEX$(BYTESGEN); "H) Bytes of object code generated" 19290 'dump sym table 19300 GOSUB 19340 19310 'reset printer 19320 IF L$ = "lpt1:" THEN PRINT#2, PMODEOFF$ 19330 RETURN 19340 '============= 19350 'DUMP_SYMTABLE 19360 '============= 19370 IF NUMSYM = PREDEF THEN RETURN 19380 PRINT#2,: PRINT#2, "SYMBOL TABLE DUMP:": XTRA = XTRA + 2: GOSUB 18670 19390 I = PREDEF + 1 19400 F$ = "\ \!\ \\ \" 'format 19410 PERLINE = LWIDTH \ LEN(F$) 19420 WHILE I <= NUMSYM 19430 H$ = HEX$(VAL1(I)): H$ = STRING$(4-LEN(H$),"0") + H$ 19440 PRINT#2, USING F$; SYM$(I); " "; H$; " "; 19450 I = I + 1 19460 IF (I - PREDEF) MOD PERLINE <> 1 THEN 19480 19470 PRINT#2,: XTRA = XTRA + 1: GOSUB 18670 19480 WEND 19490 PRINT#2,: XTRA = XTRA + 1 19500 RETURN 19510 '===== 19520 'EXIT 19530 '===== 19540 LOCATE 25,1: BEEP: COLOR BG,FG 19550 PRINT TAB(30) "Hit any key to exit" TAB(79); 19560 C$ = INKEY$: IF C$ = "" THEN 19560 19570 COLOR FG,BG: CLS: SYSTEM 19580 '============== 19590 'PROGESS REPORT 19600 '============== 19610 X = POS(0): Y = CSRLIN: LOCATE 25,1: COLOR BG,FG 19620 PRINT "Errors:"; ERRS TAB(16) "<<Esc aborts>> Pass "; 19630 IF PASS = 1 THEN PRINT "ONE"; ELSE PRINT "TWO"; 19640 PRINT " in progress."; 19650 IF PASS = 1 THEN PRINT TAB(69) "Line:"; LINENUM; ELSE PRINT TAB(61) "Line:"; LINENUM; "of"; TOTALINES; 19660 PRINT TAB(80);: COLOR FG,BG: LOCATE Y,X 19670 RETURN 19680 '=========== 19690 'FINISH_INIT 19700 '=========== 19710 GOSUB 19740 'sym table 19720 PAGE = 1: GOSUB 19840 'header 19730 RETURN 19740 '================= 19750 'SYM_TABLE 19760 'Sets up sym table 19770 '================= 19780 FOR I = 1 TO PREDEF 'pre-defined 19790 INPUT#3, SYM$(I), VAL1(I), VAL2(I), SYMTYPE(I) 19800 NEXT I 19810 NUMSYM = PREDEF 19820 CLOSE 3 19830 RETURN 19840 '====== 19850 'HEADER 19860 '====== 19870 'printer set up? 19880 IF L$ <> "lpt1:" OR PMODEON$ = "" THEN 19910 19890 PRINT#2, PMODEON$ 19900 WIDTH#2, 132: LWIDTH = 126 19910 'title & date 19920 D$ = LEFT$(DATE$,2) + "/" + MID$(DATE$,4,2) + "/" + RIGHT$(DATE$,2) 19930 PRINT#2, SC$ TAB(LWIDTH-LEN(D$)) D$ 19940 PRINT#2, "Page:"; PAGE TAB(LWIDTH-LEN(TIME$)) TIME$: PRINT#2,: PRINT#2, 19950 IF PASS = 2 AND LINENUM = TOTALINES THEN XTRA = XTRA + 6: RETURN 19960 'column headings 19970 PRINT#2,"LOC"TAB(6)"OBJ"TAB(19)"LINE"TAB(25)"SOURCE":PRINT#2, 19980 'used 7 lines 19990 XTRA = XTRA + 7 20000 RETURN 20010 '===== 20020 'ABORT 20030 '===== 20040 C$ = INKEY$: IF C$ <> CHR$(27) THEN RETURN 20050 BEEP: PRINT"Assembly aborted from keyboard." 20060 GOTO 19510 'exit 50000 '==================== 50010 'INIT 50020 'Initializes all but sym table 50030 '==================== 50040 ERRS = 0: DIAG = 0 50050 'constants 50060 GOSUB 50920 50070 'configure 50080 GOSUB 50180 50090 'expert mode? vers 3 only 50100 'gosub 60000: if found then 50150 50110 'title page 50120 GOSUB 50680 50130 'files 50140 GOSUB 51080 50150 'op table 50160 GOSUB 51670 50170 RETURN 50180 '=============== 50190 'CONFIG 50200 'Reads CHASM.CFG 50210 '=============== 50220 'defaults: 50230 PMODEON$ = "": PMODEOFF$ = "": LWIDTH = 79: AUDIO = 1 50240 FG = 7: BG = 0: MAXLINES = 58: PAGELEN = 66 50250 ON ERROR GOTO 50510 50260 OPEN "chasm.cfg" FOR INPUT AS 3 50270 ' 50280 WHILE NOT EOF(3) 50290 INPUT#3, C$ 50300 IF C$ <> "/80" THEN 50320 50310 GOSUB 50610: PMODEOFF$ = CTL$: GOTO 50440 50320 IF C$ <> "/132" THEN 50340 50330 GOSUB 50610: PMODEON$ = CTL$: GOTO 50440 50340 IF C$ <> "/LINES" THEN 50360 50350 INPUT#3, MAXLINES 50360 IF C$ <> "/PAGELEN" THEN 50380 50370 INPUT#3, PAGELEN 50380 IF C$ <> "/FG" THEN 50400 50390 INPUT#3, FG 50400 IF C$ <> "/BG" THEN 50420 50410 INPUT#3, BG 50420 IF C$ <> "/BEEP" THEN 50450 50430 INPUT#3, AUDIO 50440 IF OVERRAN THEN OVERRAN = FALSE: GOTO 50300 50450 WEND 50460 CLOSE #3 50470 'config screen 50480 WIDTH 80: COLOR FG,BG,BG: KEY OFF: CLS 50490 ON ERROR GOTO 0 50500 RETURN 50510 IF ERL = 50260 THEN 50590 50520 BEEP: COLOR FG,BG: CLS: COLOR BG,FG: LOCATE 12,25 50530 PRINT "Problem with CHASM.CFG" 50540 COLOR FG,BG: LOCATE 24,15 50550 PRINT "Hit Esc to exit, anything else to continue..."; 50560 I$ = INKEY$: IF I$ = "" THEN 50560 50570 IF I$ = CHR$(27) THEN SYSTEM 50580 CLS 50590 RESUME 50480 50600 ' 50610 OVERRAN = FALSE: CTL$ = "": INPUT#3, C$ 50620 WHILE (NOT EOF(3)) AND (LEFT$(C$,1) <> "/") 50630 CTL$ = CTL$ + CHR$(VAL(C$)) 50640 INPUT#3, C$ 50650 WEND 50660 IF EOF(3) THEN CTL$ = CTL$ + CHR$(VAL(C$)) ELSE OVERRAN = TRUE 50670 RETURN 50680 '===== 50690 'TITLE 50700 '===== 50710 CLS: LOCATE 24,1,0 50720 PRINT TAB(12)"KEY";STRING$(56,"THEN");"CLOSE 50730 PRINT TAB(12)"OPEN"TAB(69)"OPEN 50740 PRINT TAB(12)"OPEN"TAB(32)"CHASM version 2.13"TAB(69)"OPEN 50750 PRINT TAB(12)"OPEN"TAB(69)"OPEN 50760 PRINT TAB(12)"OPEN"TAB(25)"Cheap Assembler for the IBM PC"TAB(69)"OPEN 50770 PRINT TAB(12)"OPEN"TAB(69)"OPEN 50780 PRINT TAB(12)"OPEN If you have used this program and found it of OPEN 50790 PRINT TAB(12)"OPEN value, your $30 contribution will be appreciated. OPEN 50800 PRINT TAB(12)"OPEN"TAB(69)"OPEN 50810 PRINT TAB(12)"OPEN"TAB(29)"David Whitman"TAB(69)"OPEN 50820 PRINT TAB(12)"OPEN"TAB(29)"136 Wellington Terrace"TAB(69)"OPEN 50830 PRINT TAB(12)"OPEN"TAB(29)"Lansdale, PA 19446"TAB(69)"OPEN 50840 PRINT TAB(12)"OPEN"TAB(69)"OPEN 50850 PRINT TAB(12)"OPEN"TAB(69)"OPEN 50860 PRINT TAB(12)"OPEN You are encouraged to copy and share this program. OPEN 50870 PRINT TAB(12)"OPEN"TAB(69)"OPEN 50880 PRINT TAB(12)"SCREEN";STRING$(56,"THEN");"LOAD":PRINT 50890 PRINT TAB(27) "Hit any key to continue...":PRINT:PRINT 50900 I$ = INKEY$: IF I$ = "" THEN 50900 50910 CLS: RETURN 50920 '========= 50930 'CONSTANTS 50940 '========= 50950 'general 50960 TRUE = -1: FALSE = 0: DELIM$ = " ," 50970 'flag values 50980 'bits 3-5 reserved for ext. values 50990 MACHOP = 1: AUTOW = 4: ADDREG = 64: NEEDEXT = 128 51000 NEEDISP8 = 256: NEEDISP16 = 512: NEEDMODEBYTE = 1024: NEEDIMMED8 = 2048 51010 NEEDIMMED = 4096: DIRECTION = 8192: NEEDMEM = 16384: AUTOC = &H8000 51020 'operand types 51030 ACUM8 = 1: ACUM16 = 2: REG8 = 4: REG16 = 8: MEMREG = 16: CS = 32 51040 SEGR = 64: MEM = 128: IMMED8 = 256: IMMED16 = 512: NONE = 1024 51050 STRING = 2048: NEAR = 4096: FAR = 8192: CL = 16384 51060 CR$ = "Copyright (c) 1983 by David Whitman" 51070 RETURN 51080 '====================== 51090 'OPEN_FILES 51100 'Gets & opens i/o files 51110 '====================== 51120 ON ERROR GOTO 51310 51130 'input file 51140 LOCATE 1,1: INPUT"Source code file name? [.asm] ", S$ 51150 IF S$ = "" THEN BEEP: GOTO 51140 51160 'no ext, add default 51170 IF INSTR(S$,".") = 0 THEN SC$ = S$ + ".asm" ELSE SC$ = S$: S$ = LEFT$(S$,INSTR(S$,".")-1) 51180 OPEN SC$ FOR INPUT AS #1 51190 LOCATE 3,1 51200 'listing 51210 GOSUB 51510 51220 'obj file 51230 LOCATE 5,1: PRINT "Name for object file? [";S$;".com] "; 51240 INPUT "",O$ 51250 'default: 51260 IF O$ = "" THEN O$ = S$ + ".com" 51270 'open later 51280 ON ERROR GOTO 0 51290 PRINT: PRINT: PRINT 51300 RETURN 51310 '============= 51320 'Error Handler 51330 '============= 51340 IF (ERL <> 51180) AND (ERL <> 60360) THEN 51430 51350 COLOR BG,FG: BEEP 51360 PRINT SC$;" not found. Press Esc to exit, anything else to continue."; 51370 SC$ = INKEY$: IF SC$ = "" THEN 51370 51380 LOCATE ,1: COLOR FG,BG: PRINT TAB(80); 51390 IF SC$ = CHR$(27) THEN SYSTEM 51400 IF ERL = 60360 THEN FOUND = FALSE: RESUME 60600 51410 LOCATE 1,31: PRINT TAB(80); : LOCATE ,1: RESUME 51140 51420 ' 51430 IF (ERL <> 51650) AND (ERL <> 60510) THEN 51500 51440 CLOSE #2: COLOR BG,FG: BEEP 51450 PRINT"Printer not available. Press any key to continue."; 51460 L$ = INKEY$ : IF L$ = "" THEN 51460 51470 LOCATE ,1: COLOR FG,BG: PRINT TAB(80); 51480 LOCATE Y,63: PRINT TAB(80);: LOCATE ,1 51490 IF ERL = 51650 THEN RESUME 51550 ELSE ERRORFLAG = TRUE: RESUME 60520 51500 ON ERROR GOTO 0 51510 '========= 51520 'OPEN LIST 51530 '========= 51540 Y = CSRLIN 51550 INPUT"Direct listing to Printer (P), Screen (S), or Disk (D)? [nul:] ",L$ 51560 IF L$ = "" THEN L$ = "nul": GOTO 51640 'default is none 51570 IF INSTR("PpSsDd",L$) = 0 THEN BEEP: LOCATE Y,63: PRINT TAB(80): LOCATE Y,1: GOTO 51550 51580 IF L$ = "P" OR L$ = "p" THEN L$ = "lpt1:" : GOTO 51640 51590 IF L$ = "S" OR L$ = "s" THEN L$ = "scrn:" : GOTO 51640 51600 LOCATE Y,1: PRINT TAB(80);: LOCATE ,1 51610 PRINT"Name for listing file? [";S$;".lst] "; 51620 INPUT "",L$ 51630 IF L$ = "" THEN L$ = S$ + ".lst" 51640 OPEN L$ FOR OUTPUT AS 2 51650 PRINT#2,: XTRA = XTRA + 1 'test printer 51660 RETURN 51670 '======== 51680 'OP_TABLE 51690 '======== 51700 X = POS(0): Y = CSRLIN: LOCATE 25,1: COLOR BG+16,FG 51710 PRINT TAB(30) "*Set-up in progress*" TAB(80); 51720 COLOR FG,BG: LOCATE Y,X 51730 OPEN "chasm.dat" FOR INPUT AS 3 51740 FOR I = 1 TO NUMOP 51750 INPUT#3, OPCODE$(I),OPVAL(I),DSTTYPE(I),SRCTYPE(I),OFLAG(I) 51760 NEXT I 51770 RETURN